00100	C**** NOTWRT, STEM
00200	C**** ORDNT, LDGLN, TAILS, DOTIT, SAVEM, GETEM ****
00300	C***** ACCI, DIAMND, RST ***********
00400	C*** MRK, YPOS, R4SET, MRKZ, TENUTO, MRKX ***************
00500	
00600		SUBROUTINE NOTWRT
00700		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
00800		COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2,WIDX
00900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01000		COMMON /POSI/STFF(0/7),JJ2,POS
01100	C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
01200		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01300		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,
01400		1 PUNCT,JY,RJ
01500		EQUIVALENCE (J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2)),(J9,JQ(7))
01600		1,(R6,RJQ(4)),(J7,JQ(5)),(J10,JQ(8)),(J11,JQ(9)),(J6,JQ(4))
01700	 	1,(R3,RJQ(1)),(RX4,JQ(18)),(R12,RJQ(10)),(RLVL,RJQ(19))
01800		1,(R7,RJQ(5))
01900		DATA WID1/14.54/,WID2/16.2/
02000	
02100	C  NOTES****
02200		RMINI=RSTJ2
02300		RST7=7.*RMINI
02400		IF(JA.EQ.1)GO TO 11
02500		IF(JA.NE.9)GO TO 90
02600		CALL MRKX
02700		RETURN
02800	90	CALL RST
02900	C GO MAKE A REST
03000		RETURN
03100	11	JSTEM=J5/10
03200		JWHOLE=IABS(J6)
03300		IF(JWHOLE.EQ.30)JWHOLE=0
03400	C   30 IS USED IN NOTBMS & RHYTH.
03500		JACC=MOD(J5,10)
03600	C  THE ACCIDENTAL NUM.
03700		JTAIL=MOD(J7,10)
03800	C  HOW MANY TAILS
03900		JDOT=J7/10
04000	C HOW MANY DOTS
04100		NTYPE=(IABS(J4)+20)/100
04200	C NOTE TYPE CODE NUMBER (0,1,2,3,4,5)
04300		RLVL=AMOD(R4,100.)
04400	C TRUE LEVEL OF NOTE.  USED IN ACCI.
04500		IF(J10.LE.0)GO TO 9
04600		POS=STFF(J2-3+2*J10)
04700	C  FOR PUTTING NOTES ON STAFF ABOVE OR BELOW. J10=1=DOWN, =2=UP
04800		CALL CENTX
04900	9	MKS=J11
05000	C ANY MARKS?
05100		JJ4=RLVL
05200		RJAC=R3
05300	C  SAVE HOR. POS. FOR OTHER ROUTINES
05400		IF(R12.NE.0)RMINI=RMINI*R12
05500	C  R12 HAS NEW, MASTER SIZE FACTOR
05600		GO TO (1,2,3,3,5,6)NTYPE+1
05700		GO TO 6
05800	C ASSUME SPECIAL NOTES IF >5
05900	1	CALL ORDNT
06000	7	IF(JJ4.LT.2)GO TO 8
06100		IF(JJ4.LT.13)GO TO 10
06200	8	IF(J9.NE.-1)CALL LDGLN
06300	10	IF(JDOT.EQ.0)GO TO 12
06400		RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
06500	C RJAC IS ORIGINAL R3  (RESTS ALSO USE DOTIT)
06600		CALL DOTIT
06700	12	IF(JACC.NE.0)CALL ACCI
06800		IF(JSTEM.GT.0)CALL STEM
06900		IF(JTAIL.NE.0)CALL TAILS
07000		IF(MKS.NE.0)CALL MRK
07100		RETURN
07200	2	RMINI=RMINI*.6
07300	C FOR MINI (GRACE) NOTES
07400		GO TO 1
07500	3	CALL DIAMND
07600		GO TO 7
07700	5	RB=R6*RST7
07800	C USE R6 TO ADJUST SOURCE POS. OF HEADLESS NOTES (WAS R12)
07900		IF(JSTEM.EQ.2)RB=-RB
08000		J6=0
08100		GO TO 7
08200	6	CALL EXTRA
08300	C  GO USE SPECIAL NOTE PACKAGE
08400		END
08500	
08600		SUBROUTINE STEM
08700		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM
08800		COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2,WIDX
08900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
09000	C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
09100		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
09200		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,PUNCT,JY,RJ
09300		EQUIVALENCE (J5,JQ(3)),(J7,JQ(5)),(J10,JQ(8)),
09400	 	1(J6,JQ(4)),(R5,RJQ(3)) ,(R8,RJQ(6)),(R3,RJQ(1))
09500		RG=(JTAIL-1)*14
09600		IF(RG.LT.0)RG=0
09700	C 999 IS STANDARD (0) STEM LENGTH.
09800		IF(R8.NE.999.)GO TO 1751
09900		R8=0
10000		RH=0
10100		GO TO 2751
10200	1751	IF(R8.LT.999.)GO TO 751
10300		R8=R8-1000.
10400		J10=-1 
10500	C   +1000  PUTS SLASH ON NOTE STEM
10600	751	RH=R8*RST7
10700	2751	IF(JSTEM.NE.2)GO TO 1280
10800	C   STEM EXTENSIONS ARE BY NOTE #S
10900		RJX=R3
11000	C   FOR STEM DOWN (=2)
11100		RG=-RG-48.
11200		RH=-RH
11300	C RB IS SOURCE POS. OF STEM.  SET UP IN VARIOUS NOTE ROUTINES.
11400		 RB=-RB
11500	C  FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
11600		GO TO 129
11700	C   NEXT IS FOR STEM UP.
11800	1280	RJX=WIDX
11900	CC	IF(J6.LT.0)RJX=WID2
12000	C IF(J6.LT.0)GET SPACE FOR HALF NOTE
12100	2322	RJX=RJX*RMINI+R3
12200		 RG=RG+48.
12300	129	RZ=CENTR+RH+RG*RMINI
12400		RB=RB+CENTR
12500		CALL LINX(RJX,RB,RJX,RZ)
12600	C MOVES CENTR UP OR DOWN FOR NEXT TAIL
12700		END
12800		SUBROUTINE ORDNT
12900		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
13000	CC	COMMON/DAT/RACNT(69),RDOT(17),JXAC(7),RNOTE(22)
13100		COMMON/DAT/RAC(69),RDT(17),XAC(7),RNTE(22),RACCI(22),NACCI(3)
13200		COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2,WIDX
13300		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
13400		COMMON/PLTR/IPLT,RHT,DIS /POSI/STFF(0/7),JJ2,POS
13500	C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
13600		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
13700		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
13800		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
13900		1,(R6,RJQ(4)),(J7,JQ(5)),(J6,JQ(4)),(R5,RJQ(3))
14000	 	1,(R8,RJQ(6)),(R7,RJQ(5)),(R3,RJQ(1)),(RLVL,RJQ(19))
14100		RB=RMINI+RMINI
14200	C RB SETS SOURCE FOR STEM
14300		WIDX=WID1
14400	C GET STANDARD NOTE WIDTH
14500		IF(J6.LT.0)WIDX=WID2
14600	C P6<0 = WHITE NOTE
14700	C GETS WIDTH OF NOTE DISPLACEMENT
14800		RQ=WIDX
14900		IF(JWHOLE.LT.10)GO TO 1
15000	C SHIFT NOTE TO LEFT OR RIGHT OF STEM (R6=20,10)
15100	C P6 FOR HOMING TO RIGHT(10) OR LEFT(20) OF STEM(10=UP, 20=DOWN)
15200		IF(JWHOLE.EQ.20)RQ=-RQ
15300		R3=R3+RQ*RMINI
15400	1	IF(J6.GE.0)GO TO 125
15500		KL=1
15600		RG=7.  
15700	C  FOR WHITE NOTES ON DPY.
15800		J7=MOD(J7,10)
15900		IF(J7.EQ.0)GO TO 12122
16000		IF(JTAIL.NE.0)JSTEM=-JSTEM
16100	C SAVE NEG. STEM DIRECTION FOR MARKS ROUTINE
16200		JTAIL=0
16300		IF(IPLT.LT.0)GO TO 2121
16400		IF(J7.NE.2)GO TO 1253
16500	C NO DOTTED DOUBLE WHOLE NOTE??
16600		RQ=POS-18.*RSTJ2+RST7*(RLVL-1.)
16700	CC	RQ=POS-18.*RSTJ2+RST7*(R4-1.)
16800		CALL LINX(R3,RQ,R3,RQ+RST7+RST7)
16900	C PUT IN LINE TO SHOW DBL WHOLE ON SCREEN (P7=2)
17000	C SET STEM SHIFT FLAG(J6) FOR ORD. WIDTH NOTES.
17100	12122	IF(IPLT.GE.0)GO TO 1253
17200	2121	J5=15+J7
17300	C IF J7=1, THEN WHOLE NOTE SHAPE INSTEAD OF HALF. (J7=2=DBL. WHL.)
17400	12121	RG=RSTJ2
17500	C   RG  FOR NOW ;FIX THIS SOME DAY↓↓  SEE 1342+1!
17600		JX4=J4
17700		RQ=R7
17800		 CALL DRWNT 
17900	C SAVE IT FOR DOTS  
18000	C DO I NEED TO NOW?
18100		R7=RQ
18200	CC	R4=RX4
18300		J4=JX4
18400	C   GET 'EM BACK
18500		RSTJ2=RG
18600	C DRAWS GOOD NOTES ON PLOTTER, NOT ON DPY
18700		RETURN
18800	1251	CALL NOIR(RMINI)
18900	C   FOR QUARTER NOTES ON PLOTTER.
19000		RETURN
19100	125	IF(IPLT.LT.0)GO TO 1251
19200		RG=22.
19300		KL=17
19400	1253	CALL RDRAW(KL,RG,RNTE,RMINI,R3,CENTR,RMINI)
19500		END
19600	
19700	C*********  FOR LEDGER LINES  *********
19800		SUBROUTINE LDGLN
19900		COMMON /STF/RSTFAC(0/7),RSTJ2
20000		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/POSI/STFF(0/7),JJ2,POS
20100	C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
20200		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
20300		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
20400		EQUIVALENCE (J4,JQ(2)),(J9,JQ(7)) ,(R3,RJQ(1)),(J6,JQ(4))
20500		1,(J12,JQ(10)),(RLVL,RJQ(19))
20600		J4=RLVL
20700		IF(J4.LT.2)GO TO 1
20800		J12=(J4+1)/2-6
20900	C J12 FOR LEDGER LINES ABOVE STAFF
21000		GO TO 2
21100	1	J12=-((3-J4)/2)
21200	C BELOW STAFF
21300	2	RJW=R3-7.*RMINI
21400		RZ=R3+20.*RMINI
21500		IF(J12.LT.0)GO TO 71
21600		JX=J12
21700		JRX=13
21800		GO TO 711
21900	71	JRX=J12*2+3
22000		JX=-J12
22100	711	RX=POS-18*RSTJ2+RST7*JRX
22200		IF(J6.LT.0)RZ=RZ+2*RMINI
22300	126	CALL LINX(RJW,RX,RZ,RX)
22400	1126	IF(JX.EQ.1)RETURN
22500		RX=RX+RSTJ2*14.
22600		JX=JX-1
22700		GO TO 126
22800		END
22900	
23000		SUBROUTINE TAILS
23100		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
23200		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSTFAC(0/7),RSTJ2
23300		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
23400		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
23500		EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6)),(J10,JQ(8)),(RLVL,RJQ(19))
23600		R=RMINI/RSTJ2
23700		RJW=2.*R
23800		R4=RLVL
23900		RA=1.
24000	C   FOR VERT. SPACING OF MULTIPLE TAILS
24100		IF(JSTEM.NE.2)GO TO 1127
24200		R=-2.7-R8-R
24300		RJW=-RJW
24400		GO TO 2
24500	
24600	1127	R=R8-3.+R
24700	C WAS  -3.7 OR -2 BECAUSE ORIGINAL DRAWING OF TAIL WAS OFF.
24800		RA=-RA
24900	2	R4=R4+R
25000	C  R4 IS USED IN SUBR. TAIL   - R8 IS STEM EXTENSION.
25100		R=R8
25200		R8=0
25300	127	CALL TAIL
25400		JTAIL=JTAIL-1
25500		IF(JTAIL.EQ.0)GO TO 1
25600		R=R+RJW
25700	C RR8 SAVES INFO FOR MRK ROUTINE.
25800		R4=R4+RJW
25900		 GO TO 127 
26000	
26100	1	R8=R
26200	CC	R4=R4+2.
26300		IF(J10.GE.0)RETURN
26400	C RJX,RZ MUST BE SAVED PROPERLY AFTER USE IN 'STEM'
26500		RJY=-19.
26600		RH=-RSTJ2*4.
26700		IF(JSTEM.EQ.1)GO TO 1327
26800	C	IF(RA.LT.0)GO TO 1327
26900	C   NEXT IS FOR STEM DOWN SLASH
27000		RJY=23.
27100		RH=RST7
27200	
27300	1327	RJX=RJX-RST7
27400		RJY=RZ+RJY*RSTJ2
27500		RZ=RZ+RH
27600		CALL LINX(RJX,RJY,RJX+17.*RSTJ2,RZ)
27700	C FOR SLASH ON GRACE NOTE TAIL
27800		END
27900	
28000	
28100		SUBROUTINE DOTIT
28200		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
28300		1 /DAT/RAC(69),RDOT(17) /STF/RSF(8),RSTJ2 /WIDTH/WID1,WID2,WIDX
28400		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /PLTR/IPLT,RHT,DIS
28500		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
28600		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
28700		EQUIVALENCE (J4,JQ(2)),(J7,JQ(5)),(R3,RJQ(1)),(R7,RJQ(5))
28800	
28900	C NEXT FOR NOTES DISPLACED TO LEFT OR RIGHT OF STEM
29000	C  MOVES DOT TO RIGHT (THIS SHOULD BE WIDX - BUT OLD FILES WOULD BE WRONG.)
29100	C**** USE WIDX IN FRANCE?
29200		IF(JWHOLE.EQ.20)GO TO 2
29300	     	IF(JWHOLE.EQ.10.OR.J7.GT.100)RJX=RJX+WID1
29400	
29500	2     RJY=CENTR+RSTJ2
29600	      IF(MOD(J4,2).EQ.0)GO TO 108
29700	C ON A LINE OR A SPACE?
29800	      RX=RST7
29900	      IF(J7.GT.100)RX=-RX
30000	C  ADD 100 TO R7 FOR DOTS BELOW! NOTE
30100	CC    IF(JWHOLE.GE.20.OR.J7.GT.100)RX=-RX
30200	C PERHAPS SHOULD ALWAYS PUT DOT DOWN IF NOTE IS TO LEFT OF STEM??
30300	      RJY=RJY+RX
30400	
30500	108      RG=9.
30600		IF(IPLT.LT.0)RG=17.
30700	C  DOESN'T FILL DOT ON DPY
30800		IF(JDOT.GT.10)JDOT=MOD(JDOT,10)
30900		R=10.*RMINI
31000	
31100	107   CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
31200		JDOT=JDOT-1
31300		IF(JDOT.EQ.0)RETURN
31400		RJX=RJX+R
31500	CC	RJX=RJX+RSTJ2*10.
31600		GO TO 107
31700		END
31800	
31900		SUBROUTINE SAVEM
32000		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
32100		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
32200		1 RB,RJW,RZ,JX,RG,KL,RJAC /SAV/JJ9,RCEN,RR4,RR6,RR7,RR8,RR9
32300		EQUIVALENCE (R3,RJQ(1)),(R4,RJQ(2)),(RLVL,RJQ(19)),(R6,RJQ(4))
32400		1,(R7,RJQ(5)),(R8,RJQ(6)),(R9,RJQ(7)),(J9,JQ(7))
32500		RCEN=CENTR
32600		RR4=RLVL
32700		RR6=R6
32800		RR7=R7
32900		RR8=R8
33000		RR9=R9
33100		JJ9=J9
33200		END 
33300	
33400		SUBROUTINE GETEM
33500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
33600		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
33700		1 RB,RJW,RZ,JX,RG,KL,RJAC /SAV/JJ9,RCEN,RR4,RR6,RR7,RR8,RR9
33800		EQUIVALENCE (R3,RJQ(1)),(R4,RJQ(2)),(RLVL,RJQ(19)),(R6,RJQ(4))
33900		1,(R7,RJQ(5)),(R8,RJQ(6)),(R9,RJQ(7)),(J9,JQ(7))
34000		CENTR=RCEN
34100		R3=RJAC
34200		RLVL=RR4
34300		R6=RR6
34400		R7=RR7
34500		R8=RR8
34600		R9=RR9
34700		J9=JJ9
34800		END
34900		SUBROUTINE ACCI
35000		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
35100		COMMON/DAT/RAC(69),RDT(17),XAC(7),RNTE(22),RACCI(22),NACCI(3)
35200		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSTFAC(0/7),RSTJ2
35300		COMMON /FONT/JFONT /PLTR/IPLT,RHT /POSI/STFF(0/7),JJ2,POS
35400		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY
35500		EQUIVALENCE (R3,RJQ(1)),(J5,JQ(3)),(R5,RJQ(3))
35600		1,(R4,RJQ(2)),(R6,RJQ(4))
35660	CC	1,(R4,RJQ(2)),(RLVL,RJQ(19)),(R6,RJQ(4))
35700	
35800		RX=RMINI
35900		RR3=R3
36000		RR5=AMOD(R5,1.0)
36100		IF(RR5.NE.0)RR3=RR3-RR5*59.6*RMINI
36200	C  TO SPACE OUT ACCIDS.
36300		IF(JACC.GT.3)GO TO 3121
36400	C  DBL FLT(4) AND DBL SHRP(5)  ALWAYS USE 'DRAW' ROUTINE.
36500	C ADD (#) ETC.
36600		IF(IPLT.LT.0)GO TO 3121
36700		IF(JFONT.NE.0)GO TO 3121
36800		NX=NACCI(JACC)
36900		CALL RDRAW(NX+1,RACCI(NX),RACCI,RMINI,RR3,CENTR,RMINI)
37000		RETURN
37100	C  TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
37200	3121	RA=R3
37300		R3=RR3
37400	C	RJZ=AMOD(R4,100.0)
37500		J5=9
37600		IF(JACC.LT.6)GO TO 1
37700	C NEXT FOR (#) ETC.
37800		R6=2.
37900		POS=POS+21.*RMINI
38000		RMINI=RMINI*2.0
38100	C	R3=R3-3.*RMINI
38200		J5=99
38300	1	J5=J5+JACC
38400		CALL DRWNT
38500		R3=RA
38600		RMINI=RX
38700		END
     

00100		SUBROUTINE DIAMND
00200		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
00300		COMMON /WIDTH/WID1,WID2,WIDX
00400		COMMON/DAT/RACNT(69),RDOT(17),JXAC(7),RNOTE(22)
00500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /PLTR/IPLT,RHT,DIS,XDIS
00600		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
00700		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
00800		EQUIVALENCE (R3,RJQ(1)),(J5,JQ(3)),(R4,RJQ(2)),(R6,RJQ(4))
00900		1,(R7,RJQ(5)),(RX4,JQ(18)),(ISTEM,JQ(20)),(J7,JQ(5)),(J6,JQ(4))
01000	C DIAMOND NTS=180→279
01100		WIDX=WID1
01200	C SET NOTE WIDTH FOR STEM ROUTINE
01300		 KL=8
01400		RG=12.0
01500	C  FOR DIAMOND NOTES.
01600		RB=0
01700		IF(NTYPE.NE.3)GO TO 3
01800		KL=13
01900		RG=16.
02000		RB=7.*RMINI
02100	C THESE FOR X-NOTE   =280→379
02200	3	J4=R4
02300		RJZ=R4
02400		RX4=R4
02500		IF(J6.GE.0)GO TO 1
02600	C NOW FOR BLACK DIAMOND (J6=-1)
02700		J6=0
02800		J5=7
02900		RQ=R7
03000		RG=CENTR
03100	2	CALL DRWNT
03200		R7=RQ
03300		R4=RX4
03400		R6=0
03500		CENTR=RG
03600		RETURN
03700	
03800	1	JT=1
03900	C FOR DOUBLE-THICK X NOTES, HARMONICS.
04000		RH=R3
04100	1253	CALL RDRAW(KL,RG,RNOTE,RMINI,RH,CENTR,RMINI)
04200		IF(JT.LT.0)RETURN
04300		IF(IPLT.GE.0)RETURN
04400		RH=RH-1.0
04500		JT=JT-1
04600		GO TO 1253
04700		END
     

00100		SUBROUTINE RST
00200		COMMON /INTGRS/JACC,JTAIL,JDOT
00300		COMMON R2,JA,CNTR,J2,R3,R4,R5,R6,R7,R8,R9,RJR(12),RX3
00400		1,J3,J4,J5,J6,J7,J8,J9 /PTR/KWDS(1)
00500		1/LIMIT/LM,ITEM,LH,I,IX /STF/RF(8),RSTJ2 /XRN/RN(1)
00600	      COMMON/PLTR/IPLT,RHT,DIS,XDIS /POSI/STFF(0/7),JJ2,POS
00700	C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
00800	      COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
00900	     1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ
01000	 
01100	      IF(IABS(J4).LT.480)GO TO 22
01200		CALL EXTRA
01300	C  P4+500= USER-ADDED RESTS
01400	      RETURN
01500	22	IF(J6.LT.0)RETURN
01600	C J6=-1= INVIS. RESTS NEEDED IN 'PARTS' PROGRAM
01700		IF(R9.EQ.0)GO TO 302
01800		IF(R9.GT.0)GO TO 2
01900	
02000		J9=0
02100	C USE R9 FOR CENTERING. ORIG. P3 IS BASIC POS.
02200	C J9=0 NEEDED FOR CENTERED ./. REPEAT SIGN.**********
02300	C IF R9<0 CENTERING WILL BE DONE IN RSTCEN
02400	C FOR CENTERING WHOLE RESTS
02500		X=1000
02600	C FINAL POSITION WILL BE 1/2 WAY FROM 1ST NOTE POS. TO BARLINE.
02700		DO 1 K=1,ITEM
02800		L=KWDS(K)
02900		IF(RN(L+1).NE.4.)GO TO 1
03000	CC	IF(CODN(K,L).NE.4)GO TO 1
03100		IF(RN(L).GT.2)GO TO 1
03200	C FIND ONLY BARLINES (WDCNT=1)  (PUT ORD. BAR OVER DBL BAR TO MAKE THIS WORK)
03300		A=RN(L+3)
03400		IF(A.LT.X.AND.A.GT.RX3)X=A
03500	1	CONTINUE
03600		IF(X.NE.1000)R9=RX3+(X-RX3)/2.-3.0*RSTJ2
03700	C RX3 HAS IMPORTANT POS. INFO FOR NTS.
03800		IF(IPLT.GT.0)GO TO 2
03900		K=I
04000		IF(IPLT.NE.0)K=IX
04100	C PUT R9 INTO NEW PLACE IN XRN
04200		RN(K-1)=R9
04300	2	R3=RHORZ(R9)
04400		R9=0
04500	C R9=0  SO LEDGER LINE FEATURE DOESN'T GET CONFUSED.
04600	
04700	302   IF(R8.EQ.-3)R8=0
04800		 IF(R8.NE.0.AND.J5.NE.-3)J5=-2
04900	C R8=-4 OR -5 MAKES REPEAT BAR SIGN
05000	C R8=-3 IS FOR 'PAGE' PROGRAM
05100	C SO THAT REST SHAPES ARE NOT CHANGED IN FULL BAR REST.
05200	C R8 PUTS NUM OVER WHL RST ONLY. R5=-3 PUTS DBL WHL UNDER REST.
05300	      IF(J5.GT.1)R4=R4-2.
05400	      R7=R6*10.
05500	C  FOR DOTS
05600	      IF(J5.GE.2)R3=R3-3.0*RSTJ2
05700	C  SHIFTS 1/16 AND SMALLER RESTS .5 TO LEFT
05800	202	CALL REST
05900	      IF(J5.GT.1)GO TO 200
06000	      IF(R7.EQ.0)RETURN
06100	201   RA=20.7
06200	      R6=0
06300	      IF(J5.LT.0)RA=25.7
06400	      RJX=R3+RA*RMINI
06500	C RJX HAS HOROZ. POS. FOR DOTIT ROUTINE.
06600	      R4=8.+R4
06700	      J5=7
06800	C P6=1 THE REST IS DOTTED
06900		JDOT=J6
07000		CALL CENTX
07100		CALL DOTIT
07200		RETURN
07300	200   J5=J5-1
07400	C  FOR MULTIPLE TAILS ON 16TH REST, ETC.
07500	      R4=R4+2.
07600	      CALL RJBX(4.3)
07700	      GO TO 202
07800		END
07900	C****** MARKS ON NOTES **********
08000	C 4=WDG, 5=ACCNT, 7 STACC, 9=TEN, 11=DNBOW, 12=UPBOW, 13=HARM, 14=+
08100	C 15=THESIS, 16=ARSIS, 17=MORD, 18= INVMORD, 20=TR, 21=Tb, 22=T#, 23=TNAT
08200	C 25=HVYWDG, 26=FERM, 27=TEN-STACC, 28=WDG-STACC, 29=ACCNT-STACC
08300	C 30-35=FINGERING, 21-23=MUSICA FICTA
08400		SUBROUTINE MRK
08500		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
08600		COMMON/DAT/RACNT(69),RDOT(17),NXAC(7)
08700		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,
08800		1 RRR(7),RLVL,R20,JQ(20) /STF/RSTFAC(0/7),RSTJ2
08900		COMMON /FONT/JFONT /PLTR/IPLT,RHT,DIS,XDIS /POSI/STFF(0/7),JJ2,POS
09000		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
09100		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
09200		EQUIVALENCE (J5,JQ(3)),(J11,JQ(9)),(J9,JQ(7))
09300		1,(J3,JQ(1)),(RX4,JQ(18)),(ISTEM,JQ(20)),(J7,JQ(5))
09400	
09500		JSTEM=IABS(JSTEM)
09600		MRK=J11/100
09700	C GET MARK CLOSEST TO NOTE HEAD.  (LEFT 2 DIGITS)
09800		J5=J11-MRK*100
09900		R11=10.*(R11-J11)
10000		R13=R11
10100		IF(R11.EQ.0)GO TO 100
10200		IF(RSTJ2.NE.RMINI)R11=R11*RMINI/RSTJ2
10300	C***** STEM DIRECTION?????******** (MATTERS FOR J11=4,5,7,9, OR -J11
10400	C SHIFT AWAY FROM NORMAL VERTICAL POS.  (.15 SHIFTS UP 1.5 STEPS)
10500	100	RR4=R4
10600		R4=RLVL
10700		R3=RJAC
10800		J4=R4
10900		IF(J5.GT.9)GO TO 10
11000		GO TO(1,1,1,4,5,26,7,5,9)J5
11100	10	IF(J5.GT.19)GO TO 200
11200		GO TO(11,11,11,11,11,11,17,17)J5-10
11300	200	IF(J5.GT.29)GO TO 30
11400		GO TO(20,20,20,20,5,25,26,27,28,29)J5-19
11500	
11600	C**** FICTA
11700	1	J5=J5+9
11800		CALL SAVEM
11900		R7=0
12000		R6=.42
12100	C  R6 (SIZE) COULD BE CHANGED ****
12200		IF(NTYPE.EQ.1)R6=.26
12300		CALL R4SET(.8,5.8,10.5)
12400	CC	R3=R3+15.*RSTJ2
12500		R3=R3+15.*RMINI
12600		R8=0
12700		J9=0
12800		CALL CLEFS
12900	C  29 STILL OPEN FOR MARKS IN SUBR. FERMTA
13000		GO TO 31
13100	
13200	C**** WEDGE
13300	4	JX=5
13400		RX=R3+.5*RSTJ2
13500	C SHIFT A LITTLE TO RIGHT
13600	41	CALL YPOS(14.,RY)
13700		RA=RMINI
13800		RB=RA
13900		IF(JSTEM.EQ.1)RA=-RA
14000	40	CALL MRKZ(JX,RY)
14100		GO TO 300
14200	
14300	C**** ACCENT
14400	5	JX=1
14500		RX=R3
14600		GO TO 41
14700	
14800	C**** STACCATO
14900	7	RX=6.7
15000		RX=R3+RX*RMINI
15100	C PUSH DOT TO RIGHT
15200		RG=9.
15300		IF(IPLT.LT.0)RG=17.
15400	C DOESN'T FILL DOT ON DPY
15500	9	RB=14.
15600		IF(JSTEM.EQ.1)GO TO 70
15700		IF(J4.GT.9)GO TO 73
15800		GO TO 71
15900	70	IF(J4.LT.5)GO TO 73
16000	71	IF(MOD(J4,2).NE.0)RB=21.
16100	73	CALL YPOS(RB,RY)
16200		IF(J5.EQ.9)GO TO 90
16300	77	CALL RDRAW(1,RG,RDOT,RMINI,RX,RY+RSTJ2,RMINI)
16400		GO TO 300
16500	
16600	C**** TENUTO (DASH)   (STARTS ABOVE)
16700	90	CALL TENUTO(RY)
16800		GO TO 300  
16900	
17000	C*** UPBOW, ETC.
17100	11	RA=RMINI
17200		RB=RA
17300		RX=R3
17400		CALL R4SET(3.,8.,12.5)
17500		CALL CENTX
17600		CALL MRKZ(NXAC(J5-10),CENTR)
17700		GO TO 300
17800	
17900	C*** 17=MORDENT  18=INVERTED MORDENT
18000	17	RINV=J5
18100		CALL R4SET(3.,8.,12.5)
18200		GO TO 260
18300	
18400	C*** TRILL
18500	20	CALL R4SET(3.,8.,12.5)
18600		CALL SAVEM
18700		JA=7
18800		R5=0
18900		R7=1.
19000		J7=1
19100		R8=J5-20
19200	C R8 HAS THE ACCIDENTAL TO PUT OVER TR.
19300		CALL ALPHA
19400		GO TO 31
19500	C*** HEAVY WEDGE
19600	25	CALL SAVEM
19700		RINV=1.0
19800		R7=0
19900		RX4=RLVL
20000		ISTEM=JSTEM
20100		CALL FERMTA
20200		GO TO 31
20300		
20400	C*** FERMATA
20500	26	CALL SAVEM
20600		RINV=1.
20700		CALL R4SET(2.,7.,11.75)
20800	260	CALL CENTX
20900		CALL FERMTA
21000		GO TO 31
21100	
21200	C*** TENUTO-STACC. (DOT CLOSEST TO NOTE HEAD)
21300	27	MRK=-9
21400	270	J5=0
21500		GO TO 7
21600	C*** WEDGE-STACC.
21700	28	MRK=-4
21800		GO TO 270
21900	C*** ACCENT-STACC.
22000	29	MRK=-5
22100		GO TO 270
22200	
22300	C*** FINGERING
22400	30	R5=J5-30
22500	C GET THE 1 DIGIT NUM.
22600	C  PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
22700		CALL SAVEM
22800		R6=.7
22900	C  SIZE OF NUM.
23000		RX=6.
23100		IF(JSTEM.EQ.1)RX=8.
23200	C STEM UP, THEN SHIFT A LITTLE TO RIGHT
23300		J3=R3+RX*RMINI
23400		R7=0
23500		R8=0
23600		R9=0
23700		RA=2.5
23800		IF(JSTEM.EQ.1)RA=-4.
23900		R4=R4+RA 
24000	C HGT OF NUM.
24100		CALL MAKNUM(R5)
24200	C ADD HERE FOR NUMS WITH ACCENTS, ETC.
24300	
24400	31	CALL GETEM
24500	300	IF(MRK.EQ.0)RETURN
24600		IF(MRK.GT.0)GO TO 301
24700	C WILL ONLY DO  CERTAIN COMBINATIONS OF MARKS
24800	C  THIS FEATURE NEEDS MORE WORK
24900		MRK=-MRK
25000	C ACCENT,DASH,WEDGE OVER STACC.
25100		IF(MRK.EQ.9)GO TO 304
25200	C JUMP FOR TENUTO.  NEXT FOR ACCENT OR WEDGE
25300		IF(JSTEM.EQ.1)GO TO 305
25400		J5=1
25500		IF(J4.GT.9)GO TO 303
25600	306	IF(MOD(J4,2).NE.0)J5=J5*2
25700		GO TO 303
25800	305	J5=-1
25900		IF(J4.LT.5)GO TO 303
26000		GO TO 306
26100	304	IF(JSTEM.EQ.1)GO TO 302
26200		J5=1
26300		IF(J4.LT.9)J5=2
26400		GO TO 303
26500	C WHAT ABOUT IF NO LEDGER LINES?
26600	302	J5=-1
26700		IF(J4.GT.5)J5=-2
26800	303	J4=J4+J5
26900		R4=J4
27000		CALL CENTX
27100	301	J5=MRK
27200	C GET 2ND MARK
27300		MRK=0
27400		GO TO 100
27500		END
27600	
     

00100		SUBROUTINE YPOS(R,RY)
00200		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM
00300		COMMON R2,JA,CENTR,J2,RJQ(9),R12,R13 /STF/RSTFAC(0/7),RSTJ2
00400		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI
00500		RB=R+R13*7.
00600		IF(JSTEM.EQ.1)RB=-RB
00700	C 1=STEM UP, 2=STEM DOWN
00800		RY=RSTJ2
00900		IF(R12.NE.0)RY=RMINI
01000	C FOR NEW GENERAL SIZE FACTOR
01100		RY=CENTR+RB*RY
01200		END
01300	
01400		SUBROUTINE R4SET(R,S,T)
01500		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
01600		COMMON R2,JA,CENTR,J2,RJQ(20)
01700		EQUIVALENCE (R11,RJQ(9)),(R4,RJQ(2)),(R8,RJQ(6))
01800		Q=R
01900		IF(JSTEM.EQ.1)Q=S+R8
02000		R4=R4+Q
02100		IF(R4.LT.T)R4=T
02200		R4=R4+R11
02300	C R11=DISPLACEMENT  ****** CHECK THIS
02400		END
02500	
02600		SUBROUTINE MRKZ(JX,Y)
02700		COMMON/DAT/RACNT(69),RDOT(17),NXAC(7)
02800		COMMON R2,JA,CNTR,J2,RJQ(20),J3,J4,J5 /PLTR/IPLT,RHT,DIS,XDIS
02900		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,RB
03000		JT=0
03100		IF(IPLT.LT.0)JT=-2
03200	C JT IS FOR THICKENING WHEN PLOTTING
03300		JX1=JX+1
03400	43	CALL RDRAW(JX1,RACNT(JX),RACNT,RA,RX,Y,RB)
03500		IF(JT.EQ.0)RETURN
03600		JT=JT+1
03700		IF(J5.EQ.13)GO TO 42
03800		Y=Y-XDIS
03900		IF(J5.EQ.14)RX=RX-XDIS
04000	C 14=PLUS
04100		GO TO 43
04200	42	RB=RB+.03
04300	C INCREASE SIZE FOR THICKENING HARMONIC
04400		GO TO 43
04500		END
04600	
04700		SUBROUTINE TENUTO(Y)
04800	C**** TENUTO (DASH)  
04900		COMMON R2,JA,CNTR,J2,R3  /PLTR/IPLT,RHT,DIS,XDIS
05000		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX
05100		RX=R3+RMINI*14.
05200		CALL LINX(R3,Y,RX,Y)
05300		IF(IPLT.GE.0)RETURN
05400	C MAKE THICKER IF PLOTTING
05500		Y=Y-XDIS
05600		CALL LINX(R3,Y,RX,Y)
05700		END
     

00100	C******CODE 9 MARKS **********
00200	C 4=WDG, 5=ACCNT, 7 STACC, 9=TEN, 11=DNBOW, 12=UPBOW, 13=HARM, 14=+
00300	C 15=THESIS, 16=ARSIS, 17=MORD, 18= INVMORD, 20=TR, 21=Tb, 22=T#, 23=TNAT
00400	C 25=HVYWDG, 26=FERM, 27=TEN-STACC, 28=WDG-STACC, 29=ACCNT-STACC
00500	C 30-35=FINGERING, 21-23=MUSICA FICTA
00600		SUBROUTINE MRKX
00700		COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
00800		COMMON/DAT/RACNT(69),RDOT(17),NXAC(7)
00900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSTFAC(0/7),RSTJ2
01000		COMMON /PLTR/IPLT,RHT,DIS,XDIS /POSI/STFF(0/7),JJ2,POS
01100		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01200		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
01300		EQUIVALENCE (R3,RJQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(R11,RJQ(9))
01400		1,(R4,RJQ(2)),(RLVL,RJQ(19)),(R6,RJQ(4)),(J11,JQ(9)),(J9,JQ(7))
01500		1,(R7,RJQ(5)),(R8,RJQ(6)),(R9,RJQ(7)),(J3,JQ(1)),(RX4,JQ(18))
01600		1,(ISTEM,JQ(20)),(J7,JQ(5))
01700	
01800		RMINI=RSTJ2
01900		RINV=1.
02000		IF(J5)2,21,101
02100	C GO BACK IF NO NUM. IN J5
02200	21	RETURN
02300	2	J5=-J5
02400		RINV=-RINV
02500	101	CALL NOZERO(R6)
02600		RMINI=RMINI*R6
02700		JSTEM=0
02800		ISTEM=0
02900		IF(IABS(J4).LT.80)GO TO 100
03000		R4=AMOD(R4,100.)
03100		RMINI=RMINI*.7
03200	100	IF(J5.GT.9)GO TO 10
03300		GO TO(1,1,1,4,5,26,7,5,9)J5
03400	10	IF(J5.GT.19)GO TO 200
03500		GO TO(11,11,11,11,11,11,17,17)J5-10
03600	200	IF(J5.GT.29)GO TO 30
03700		GO TO(20,20,20,20,5,25,26)J5-19
03800	
03900	C**** FICTA
04000	1	JACC=J5
04100		RLVL=R4
04200		CALL ACCI
04300		RETURN
04400	
04500	C**** WEDGE
04600	4	JX=5
04700		RX=R3+.5*RSTJ2
04800	C SHIFT A LITTLE TO RIGHT
04900	41	RA=RMINI
05000		RB=RA
05100		IF(RINV.LT.0)RA=-RA
05200	40	CALL MRKZ(JX,CENTR)
05300		RETURN
05400	
05500	C**** ACCENT
05600	5	JX=1
05700		RX=R3
05800		GO TO 41
05900	
06000	C**** STACCATO
06100	7	RX=R3+6.7*RMINI
06200	C PUSH DOT TO RIGHT
06300		RG=9.
06400		IF(IPLT.LT.0)RG=17.
06500	C DOESN'T FILL DOT ON DPY
06600		RB=14.
06700	77	CALL RDRAW(1,RG,RDOT,RMINI,RX,CENTR+RSTJ2,RMINI)
06800		RETURN
06900	
07000	C**** TENUTO (DASH)   (STARTS ABOVE)
07100	9	CALL TENUTO(CENTR)
07200		RETURN
07300	
07400	C*** UPBOW, ETC.
07500	11	JX=NXAC(J5-10)
07600		RA=RMINI
07700		RB=RA
07800		RX=R3
07900		GO TO 40
08000		
08100	C*** 17=MORDENT  18=INVERTED MORDENT
08200	17	RINV=J5
08300		GO TO 26
08400	
08500	C*** TRILL
08600	20	JA=7
08700		R5=0
08800		J7=1
08900		R7=1.
09000		R8=J5-20
09100	C R8 HAS THE ACCIDENTAL TO PUT OVER TR.
09200		CALL ALPHA
09300		RETURN
09400	
09500	C*** HEAVY WEDGE
09600	25	R7=0
09700		ISTEM=2
09800		IF(RINV.LT.0)ISTEM=1
09900		RX4=R4
10000		
10100	C*** FERMATA
10200	26	CALL FERMTA
10300		RETURN
10400	
10500	C*** FINGERING
10600	30	R5=J5-30
10700	C GET THE 1 DIGIT NUM.
10800	C  PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
10900		RX=8.
11000	C 8. SETS POS. AS IF NUM.WERE UNDER NOTE WITH STEM UP.
11100		J3=R3+RX*RMINI
11200		R6=.7
11300		R7=0
11400		R8=0
11500		R9=0
11600		R4=R4+2.5
11700		CALL MAKNUM(R5)
11800	C ADD HERE FOR NUMS WITH ACCENTS, ETC.
11900		END